perm filename FILLR.SAI[PUB,TES] blob
sn#129301 filedate 1974-11-04 generic text, type T, neo UTF8
00100 BEGOF("FILLR")
00200
00300 COMMENT
00400 This module fills a text line with as many words as can fit. The file
00500 HORIZ handles positioning within a line, such as scripts, tabs, and
00600 centering.
00700
00800 The routines build a first pass output line in string OWL and then
00900 call the line paster (PLACELINE()) to place it in an area. OWL is
01000 kept lengthy enough to hold any first pass output line. That way, a
01100 line can be constructed by IDPB'ing (with APPEND()) inside OWL
01200 instead of by numerous concatenations.
01300
01400 Characters in OWL[1 TO OAKS] belong to the current line being built.
01500 However, some of these characters describe FONT changes or forward
01600 label references and others mark word breaks or CR to the left margin
01700 for superimposing. Thus, the line reaches only to column POSN
01800 (relative to the left edge of the area), and FAKE of these columns
01900 are not occupied but are only allocated for forward references.
02000
02100 In FILL mode, the last permissible point after which the line can be
02200 broken by a CrLf is marked by four variables: BRKPT, BRKPOSN,
02300 BRKSPCS, and BRKFAKE, which contain the values of OAKS, POSN, and
02400 FAKE at that point, and the number of delible spaces right after that
02500 point. Though there is normally a WDBRK character at the breakpoint,
02600 there may be none if it is the first breakpoint on the line or if it
02700 was caused by a hyphen.
02800
02900 TEXTLINE sets up the input stream for processing by TEXTSEGMENT.
03000 TEXTSEGMENT scans it up to a {, cr, or altmode, obeying all control
03100 characters (see SCANTEXT in file CTRLC) and EMITting all regular
03200 characters. EMIT calls APPEND after checking for line overflow, etc.
03300 Spaces are handled differently -- instead of calling EMIT to APPEND
03400 them immediately, EMSPACES is called, which just counts up spaces in
03500 SPCS and handles COMPACTion and punctuation problems. Thus, when
03600 EMIT is called, it must append SPCS spaces before appending its
03700 argument.
03800
03900 ;
04000
04100 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE FILLR! ;$"#
00200 BEGIN "FILLR!"
00300 INTEGER I ;
00400 SPSSTR ← SP ;
00500 FOR I ← 1 THRU 200 DO SPSSTR ← SPSSTR&SP ;
00600 END "FILLR!" ;
00100 PUBLIC SIMPLE PROCEDURE APPEND(STRING CHARS) ;$"#
00200 IF ON THEN
00300 BEGIN "APPEND"
00400 STRING D ; INTEGER CCT, BALANCE ;
00500 DEFINE SRC=['15], COUNT=['14], DEST=['13], CHAR=['11] ;
00600 CCT ← LENGTH(CHARS) ;
00700 IF (BALANCE ← LENGTH(OWL) - (OAKS+CCT)) < 0 THEN
00800 OWL ← OWL & SP & SPS((1-BALANCE)*2) ;
00900 IF CCT > 0 THEN
01000 BEGIN
01100 LABEL IUD ; COMMENT DEPOSIT LOOP ;
01200 D ← OWL[OAKS+1 FOR 1] ;
01300 START!CODE "APPD"
01400 MOVE SRC, CHARS ;
01500 HRRZ COUNT, CCT ;
01600 ADDM COUNT, OAKS ;
01700 MOVE DEST, D ;
01800 IUD: ILDB CHAR, SRC ;
01900 IDPB CHAR, DEST ;
02000 SOJG COUNT, IUD ;
02100 END "APPD"
02200 END ;
02300 END "APPEND" ;
00100 PUBLIC SIMPLE PROCEDURE COMPMAXIMS ;$"#
00200 BEGIN "COPYMAXIMS"
00300 FMAXIM ← (RMARG-RIGHTIM)-LMARG ;
00400 NMAXIM ← COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT)-LMARG ;
00500 MAXIM ← IF FILL THEN FMAXIM ELSE NMAXIM ;
00600 END "COPYMAXIMS" ;
00100 PUBLIC RECURSIVE PROCEDURE EMIT(STRING CHARS) ;$"#
00200 IF ON THEN EMITPIECE(CHARS, LENGTH(CHARS), XLENGTH(CHARS)) ;
00100 PUBLIC RECURSIVE PROCEDURE EMITPIECE(STRING CHARS; INTEGER NCHARS, XCHARL) ;$"#
00200 BEGIN TES PROCEDURIZED 11/29/73 ;
00300 INTEGER EXCHARS, WASBRC ; STRING EXCESS ; LABEL ADDIT ; comment Sorry about that ;
00400 INTEGER XSPCL,XEXCHARS; RKJ;
00500 XSPCL ← XSPLEN(SPCS) ; RKJ;
00600 RKJ: OLD LINE IF POSN + SPCS + NCHARS LEQ MAXIM THEN comment, no overfow ;
00700 IF (IF XCRIBL THEN (XPOSN+XSPCL+XCHARL LEQ XMAXIM) ELSE (POSN+SPCS+NCHARS LEQ MAXIM)) THEN comment no overflow;
00800 ADDIT:
00900 BEGIN
01000 IF SPCS AND XCRIBL AND (FILL AND ADJUST) AND POSN>INDENT THEN
01100 BEGIN FSHORT←FSHORT+XSPLEN(1); SPCS←SPCS-1 END;
01200 IF SPCS THEN BEGIN APPEND(SPS(SPCS)) ; BRKSPCS ← SPCS END ;
01300 APPEND(CHARS) ; POSN ← POSN + SPCS + NCHARS ; SPCS ← 0 ;
01400 XPOSN ← XPOSN + XSPCL + XCHARL; RKJ;
01500 END
01600 ELSE IF FILL AND (BRKPT>INDENT OR BRKPOSN>INDENT) THEN comment, go back to a break point ;
01700 BEGIN
01800 IF BRKPT=OAKS THEN BEGIN XSPCL ← SPCS ← EXCHARS ← 0 ; EXCESS ← NULL END
01900 ELSE BEGIN EXCESS←OWL[BRKPT+1+BRKSPCS TO OAKS]; COPY(EXCESS);
02000 XEXCHARS ← XPOSN-FSHORT-BRKXPOSN-BRKSPCS*XSPLEN(1);
02100 EXCHARS←POSN-BRKPOSN-BRKSPCS END;
02200 FAKE ← FAKE - BRKFAKE ; NOPGPH ← -1 ; WASBRC ← BRC ;
02300 OAKS ← BRKPT ; BOUND(3) ; COMMENT ADDED 4/14/72 ;
02400 PLACELINE(IF OWL[OAKS FOR 1]=WDBRK AND LASTWDBRK=OAKS COMMENT JAN 9 73 ;
02500 THEN OAKS-1 ELSE OAKS, BRKPOSN MIN MAXIM, BRKXPOSN,
02600 BRKFAKE, BRKABX, -BRKBLX, IF FIRST THEN LEADFM ELSE SPREADM-1,
02650 IF FIRST THEN MLEADFM ELSE MSPREADM,
02700 BRKPLBL, ADJUST, SPREADM) ;
02800 FSHORT ← NOPGPH ← OAKS ← TABI ← BRKABX ← BRKBLX ← STARPOSN ← AMPPOSN ← LASTWDBRK ← 0 ; BRC←WASBRC;
02900 COMMENT VARIABLES NEEDED BEYOND THE ABOVE "PLACELINE"
03000 HAD BETTER BE "MIDWDS" IN PUBDFS.SAI ;
03100 IF FIRST THEN BEGIN
03200 INDENT ← RESTIM MAX -LMARG ; FIRST ← FALSE ;
03300 END ;
03400 IF XCRIBL
03500 THEN
03600 BEGIN
03700 APPEND(PICKFONT(BRKFONT)) ; BRKFONT ← THISFONT ; TES 11/16/73 ;
03800 IF (LMARG+INDENT) NEQ 0 THEN APPEND(FONTCHAR&"="&CVSR(CHARW*(LMARG+INDENT)));
03900 XPOSN←CHARW*INDENT;
04000 END
04100 ELSE
04200 BEGIN
04300 APPEND(SPS(LMARG+INDENT));
04400 END;
04500 POSN←INDENT;
04600 IF BRKUNDER THEN BEGIN APPEND(FONTCHAR&"_"); BRKUNDER ← 0 END ; TES 12/28/73;
04700 OKCR(TRUE); TES MOVED AFTER BRKUNDER TEST, 12/28/73 ;
04800 APPEND(EXCESS);
04900 POSN←POSN+EXCHARS; XPOSN←XPOSN+XEXCHARS;
05000 IF SPCS THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ;
05100 GO TO ADDIT ;
05200 END
05300 ELSE IF (IF XCRIBL THEN XPOSN LEQ XMAXIM ELSE POSN LEQ MAXIM)
05400 THEN comment, About to overflow right edge of area! ;
05500 BEGIN "LINE TOO LONG"
05600 STRING S; RKJ: 1-5-74;
05700 S←SPS(SPCS)&CHARS; RKJ: 1-5-74;
05800 APPEND((IF XCRIBL THEN (EXCESS←TRUNCATE(S,XMAXIM-XPOSN)) ELSE S[1 TO MAXIM - POSN])) ;
05900 IF XCRIBL AND FNTFIL[DEFAULTFONT]=0 THEN TES 11/15/73;
06000 WARN("=", "FONT declaration needed. Start over!")
06100 ELSE
06200 WARN("Line too long",<(IF NOFILL THEN "Nofill" ELSE "Fill") & " line too long -- characters lost:" &
06300 S[(IF XCRIBL THEN LENGTH(EXCESS)+1 ELSE MAXIM-POSN+1) TO ∞] & "...">) ;
06400 POSN ← MAXIM+1 ; SPCS ← 0 ;
06500 XPOSN ← XMAXIM + 1; RKJ;
06600 END ;
06700 MIDWORD ← MIDWORD OR FULSTR(CHARS) ; PUNC ← FALSE ;
06800 END "EMITPIECE" ;
00100 PUBLIC SIMPLE PROCEDURE EMSPACES(INTEGER N) ;$"#
00200 IF ON THEN BEGIN
00300 IF SPCS=0 THEN BEGIN OKSP(FALSE) ; OKCR(FALSE) END ; MIDWORD ← FALSE ;
00400 SPCS ← IF COMPACT THEN (SPCS+N) MIN (IF PUNC THEN 2 ELSE 1) ELSE SPCS+N ;
00500 END "EMSPACES" ;
00100 PUBLIC SIMPLE PROCEDURE OKCR(BOOLEAN EVEN!IN!SUPERSUBSCRIPT) ;$"#
00200 IF BRKPT NEQ OAKS AND ON AND (SUPERSUB=0 OR EVEN!IN!SUPERSUBSCRIPT) THEN
00300 BEGIN
00400 BRKPT ← OAKS ; BRKPOSN ← POSN ; BRKFAKE ← FAKE ; BRKPLBL ← PLBL ; BRKSPCS ← 0 ;
00500 BRKUNDER ← UNDERLINING ; TES 12/28/73 ;
00600 BRKFONT ← THISFONT ; TES 11/16/73 ;
00700 BRKXPOSN ← XPOSN - FSHORT ;
00800 IF SUPERSUB THEN RETURN ;
00900 BRKABX ← BRKABX MAX ABOVEX ; BRKBLX ← BRKBLX MIN BELOWX ; ABOVEX←BELOWX←0 ;
01000 END "OKCR" ;
00100 PRIVATE SIMPLE PROCEDURE OKSP(BOOLEAN EVEN!BEFORE!LMARG) ;$"#
00200 IF LASTWDBRK NEQ OAKS AND ON AND
00300 JUSTIFY AND (POSN<MAXIM OR XCRIBL) AND (EVEN!BEFORE!LMARG OR POSN > 0 MAX INDENT) THEN
00400 BEGIN APPEND(WDBRK) ; LASTWDBRK ← OAKS ; END ;
00100 PUBLIC RECURSIVE PROCEDURE PGPHSTART ;$"#
00150 IF ON THEN
00200 BEGIN "PGPHSTART"
00300 OAKS←SPCS←TABI←PUNC←MIDWORD←SUPERSUB← 0 ;
00400 ABOVEX←BELOWX←HEIGHT←FAKE←BRKABX←BRKBLX←UNDERLINING← 0 ;
00500 FIRST ← NOFILL OR NOPGPH<0 ;
00600 STARPOSN←AMPPOSN←LASTWDBRK←0 ;
00700 BRKFONT ← THISFONT ; TES 11/16/73 ;
00800 BRKUNDER ← 0 ; TES 12/28/73 ;
00900 INDENT ← IF FLUSHL OR VERBATIM OR CENTER OR FLUSHR THEN 0
01000 ELSE (IF NOFILL OR FIRST THEN FIRSTIM ELSE RESTIM) MAX -LMARG ;
01100 NOPGPH ← 0 ;
01200 LBK ← 3 ; LBF ← NULL ;
01300 IF XCRIBL THEN
01400 BEGIN
01500 APPEND(PICKFONT(THISFONT)) ; TES 11/15/73 ;
01600 IF (LMARG+INDENT) NEQ 0 THEN APPEND(FONTCHAR&"="&CVSR(CHARW*(LMARG+INDENT)));
01700 XPOSN←CHARW*INDENT;
01800 END
01900 ELSE BEGIN
02000 APPEND(SPS(LMARG+INDENT));
02100 END;
02200 POSN←INDENT; FSHORT←0; OKCR(TRUE);
02300 IF FLUSHR THEN BOUND(2) ELSE IF CENTER THEN BOUND(1) ;
02400 FMAXIM ← (RMARG-RIGHTIM)-LMARG ;
02500 NMAXIM ← COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT) - LMARG ;
02600 MAXIM ← IF FILL THEN FMAXIM ELSE NMAXIM ;
02700 END "PGPHSTART" ;
00100 PUBLIC STRING SIMPLE PROCEDURE SPS(INTEGER N) ;$"#
00200 IF N LEQ 10 THEN RETURN(SPSARR[N MAX 0])
00300 ELSE RETURN(SPSSTR[1 TO N]) ;
00100 PUBLIC INTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;$"#
00200 BEGIN
00300 PRELOAD!WITH 6, [8]0, 1, [2]0, 5, 0, 3, [4]4, [6]0, 4, 2, 4, 2, [2]0 ;
00400 OWN INTEGER ARRAY TEXTTYPE[-15:15] ;
00500 BOOLEAN IMITEXT ; INTEGER USYMB, LEN ; STRING STR ;
00600 IMITEXT ← TRUE ; comment assume computed text line ;
00700 CASE TEXTTYPE[THISTYPE] OF
00800 BEGIN COMMENT BY TYPE ;
00900 COMMENT 0 ... Invalid ; RETURN(FALSE) ;
01000 COMMENT 1 ... [ ; BEGIN comment [Est] Label or [@] rubout gen-label ; PASS ;
01100 IF ITSCH(@) THEN BEGIN PASS ; IMITEXT ← FALSE END
01200 ELSE BEGIN LEN ← CVD(E("5", 0)) ; COMMENT THANKS RKJ ;
01300 IF ITSCH(<]>) THEN PASS ELSE
01400 WARN("=",<"Missed ] after label length; You probably thought you had" & CRLF &
01500 "a subscripted variable like X[I] computing text;" & CRLF &
01600 "but the syntax of that would be (X[I]). See" & CRLF &
01700 "p.21 in the manual for parenthesis rules.">) ;
01800 THISWD ← LABELREF(0, LEN) ; END ;
01900 END ;
02000 COMMENT 2 ... Unit ; IF THATISID THEN
02100 BEGIN comment Unit Label ;
02200 USYMB ← SYMB ;
02300 LEN ← IF THISTYPE=PCOUNTERTYPE THEN PATT!CHRS(IX) ELSE CTR!CHRS(IX) ;
02400 PASS ; THISWD ← LABELREF(USYMB, LEN) ;
02500 END
02600 ELSE IF IX=IXPAGE THEN
02700 BEGIN comment, Generate a label ;
02800 THISWD ← NULL ;
02900 THISWD ← LABELREF(0, IF ITS(PAGE) THEN CTR!CHRS(IXPAGE) ELSE PATT!CHRS(IXPAGE)) ;
03000 END
03100 ELSE THISWD ← VEVAL ;
03200 COMMENT 3 ... Constant ;
03300 BEGIN
03400 LOPP(THISWD) ; STR ← THISWD ; TES 8/19/74 FIX BUG ;
03500 IF THATISID AND SIMLOOK(CAPITALIZE(STR←SCAN(STR,ALPHA,DUMMY)))
03600 AND (SYMTYPE = COUNTERTYPE OR SYMTYPE = PCOUNTERTYPE) THEN
03700 BEGIN comment "Unit.." Label ;
03800 IF SYMTYPE=PCOUNTERTYPE THEN STR←STR[1 TO ∞-1]; USYMB ← SYMBOL;
03900 LEN ← IF SYMTYPE=PCOUNTERTYPE THEN PATT!CHRS(SYMIX) ELSE CTR!CHRS(SYMIX) ;
04000 PASS ; THISWD ← STR & SP & LABELREF(USYMB, LEN) ;
04100 END ;
04200 END ;
04300 COMMENT 4 ... Variable ; THISWD ← VEVAL ;
04400 COMMENT 5 ... } etc. ; IF IX comment not } ; THEN RETURN(FALSE) ELSE IMITEXT←FALSE ;
04500 COMMENT 6 ... misc ; IF ITSCH(<(>) THEN BEGIN PASS; STR←E(NULL,NULL);
04600 IF NOT ITSCH(<)>) THEN WARN("=","Parens don't match") ; THISWD←STR END ELSE RETURN(FALSE) ;
04700 END ; COMMENT BY TYPE ;
04800 IF IMITEXT THEN IF NULSTR(THISWD) OR NOT ON THEN ELSE
04900 BEGIN
05000 BEGINBLOCK(FALSE, 0, "COMPUTED!TEXT") ;
05100 SWICH(THISWD&ALTMODE&" END ""COMPUTED!TEXT""", -1, 0) ;
05200 TEXTSEGMENT ;
05300 END
05400 ELSE TEXTSEGMENT ;
05500 PASS ;
05600 RETURN(TRUE) ;
05700 END "TEXTLINE" ;
00100 PRIVATE RECURSIVE PROCEDURE TEXTSEGMENT ;$"#
00200 BEGIN
00300 INTEGER INSET, N ;
00400 EMPTYTHIS ; INSET ← 0 ;
00500 IF INPUTSTR = VT THEN IF NOT ON THEN LOPP(INPUTSTR) ELSE
00600 BEGIN "NEW INPUT LINE"
00700 LOPP(INPUTSTR) ;
00800 IF VERBATIM THEN BEGIN END
00900 ELSE IF INPUTSTR=CR AND (N←SIGNALD[CR]) THEN BEGIN LOPP(INPUTSTR) ; RESPOND(N) ; RETURN END
01000 ELSE IF ATLEAD(INSET ← LENGTH(RD(TO!NON!SP))) THEN INSET←0 ; comment AT NULL , AT <integer> ;
01100 END "NEW INPUT LINE" ;
01200 IF NOPGPH THEN
01210 BEGIN
01220 PGPHSTART ; TES 11/2/74 PROCEDURIZED ;
01230 IF ON AND VERBATIM THEN
01240 BEGIN
01250 JUSTIFY←FALSE;
01260 EMIT(RD(TO!CR!SKIP));
01270 DBREAK ;
01280 RETURN ;
01290 END ;
01295 END ;
03800 JUSTIFY ← FILL AND ADJUST OR JUSTJUST ;
03900 IF INSET AND RETAIN AND NOT FLUSHL THEN EMSPACES(INSET) ;
04000 SCANTEXT ;
04100 END "TEXTSEGMENT " ;
00100 FINISHED
00200
00300 ENDOF("FILLR")